home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-prn.el.z / ilisp-prn.el
Encoding:
Text File  |  1998-05-21  |  3.0 KB  |  100 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-prn.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24.  
  25. ;;;
  26. ;;;
  27. ;;; ILISP paren handling
  28. ;;;
  29. ;;;
  30.  
  31.  
  32. ;;;%Unbalanced parentheses
  33. (defun lisp-skip (end)
  34.   "Skip past whitespace, comments, backslashed characters and strings
  35. in the current buffer as long as you are before END.  This does move
  36. the point."
  37.   (if (< (point) end)
  38.       (let ((comment (and comment-start (string-to-char comment-start)))
  39.         (done nil)
  40.         char)
  41.     (while (and (< (point) end)
  42.             (not done))
  43.       (skip-chars-forward "\n\t " end)
  44.       (setq char (char-after (point)))
  45.       (cond ((eq char ?\")
  46.          (forward-sexp))
  47.         ((eq char comment)
  48.          (forward-char)
  49.          (skip-chars-forward "^\n" end))
  50.         ((eq char ?\\)
  51.          (forward-char 2))
  52.         (t (setq done t)))))))
  53.  
  54. ;;;
  55. (defun lisp-count-pairs (begin end left-delimiter right-delimiter)
  56.   "Return the number of top-level pairs of LEFT-DELIMITER and
  57. RIGHT-DELIMITER between BEGIN and END.  If they don't match, the point
  58. will be placed on the offending entry."
  59.   (let ((old-point (point))
  60.     (sexp 0)
  61.     left)
  62.     (goto-char begin)
  63.     (lisp-skip end)
  64.     (while (< (point) end)
  65.       (let ((char (char-after (point))))
  66.     (cond ((or (eq char left-delimiter)
  67.            ;; For things other than lists
  68.            (eq (char-after (1- (point))) ?\n))
  69.            (setq sexp (1+ sexp))
  70.            (if (condition-case ()
  71.                (progn (forward-sexp) nil)
  72.              (error t))
  73.            (error "Extra %s" (char-to-string left-delimiter))))
  74.           ((eq char right-delimiter)
  75.            (error "Extra %s" (char-to-string right-delimiter)))
  76.           ((< (point) end) (forward-char))))
  77.       (lisp-skip end))
  78.     (goto-char old-point)
  79.     sexp))
  80.  
  81. ;;;
  82. (defun find-unbalanced-region-lisp (start end)
  83.   "Go to the point in region where LEFT-DELIMITER and RIGHT-DELIMITER
  84. become unbalanced.  Point will be on the offending delimiter."
  85.   (interactive "r")
  86.   (lisp-count-pairs start end
  87.             (string-to-char left-delimiter)
  88.             (string-to-char right-delimiter))
  89.   (if (not ilisp-complete) (progn (beep) (message "Delimiters balance"))))
  90.  
  91. ;;;
  92. (defun find-unbalanced-lisp (arg)
  93.   "Go to the point in buffer where LEFT-DELIMITER and RIGHT-DELIMITER
  94. become unbalanced.  Point will be on the offending delimiter.  If
  95. called with a prefix, use the current region."
  96.   (interactive "P")
  97.   (if arg
  98.       (call-interactively 'find-unbalanced-region-lisp)
  99.       (find-unbalanced-region-lisp (point-min) (point-max))))
  100.